VERSION 5.00
Begin VB.UserControl SimpleProgress 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   Begin VB.Image i1 
      Height          =   240
      Left            =   3240
      Picture         =   "SimpleProgress.ctx":0000
      Top             =   840
      Width           =   240
   End
End
Attribute VB_Name = "SimpleProgress"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private mx As Long, v As Long
Private cap As String

Private bm As New cAlphaDibSection
Private bm1 As New cAlphaDibSection
Private bmx As New cAlphaDibSection

Public Property Get Max() As Long
Max = mx
End Property

Public Property Let Max(ByVal n As Long)
mx = n
'pRedraw
End Property

Public Property Get Value() As Long
Value = v
End Property

Public Property Let Value(ByVal n As Long)
v = n
'pRedraw
End Property

Public Property Get Caption() As String
Caption = cap
End Property

Public Property Let Caption(ByVal s As String)
cap = s
pRedraw
End Property

Private Sub pInit()
pRedraw
End Sub

Private Sub UserControl_Initialize()
bmx.CreateFromPicture i1.Picture
UserControl_Resize
End Sub

Private Sub UserControl_InitProperties()
mx = 100
cap = Extender.Name
pInit
End Sub

Private Sub UserControl_Paint()
bm.PaintPicture hdc
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
 mx = .ReadProperty("Max", 100)
 v = .ReadProperty("Value", 0)
 cap = .ReadProperty("Caption", Extender.Name)
End With
pInit
End Sub

Private Sub UserControl_Resize()
Dim w As Long, h As Long
w = ScaleWidth
h = ScaleHeight
bm.Create w, h
bm1.Create w, h
pRedraw
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
 .WriteProperty "Max", mx, 100
 .WriteProperty "Value", v, 0
 .WriteProperty "Caption", cap, Extender.Name
End With
End Sub

Private Sub pRedraw()
On Error Resume Next
Dim w As Long, h As Long
Dim i As Long
w = bm.Width
h = bm.Height
'draw back and thumb
If mx > 0 Then
 i = (v * (w - 6)) \ mx
Else
 i = 0
End If
StretchBlt bm.hdc, 3, 3, w - 6, h - 6, bmx.hdc, 14, 0, 1, 16, vbSrcCopy
StretchBlt bm.hdc, 3, 3, i, h - 6, bmx.hdc, 15, 0, 1, 16, vbSrcCopy
'draw border
bmx.PaintPicture bm.hdc, 0, 0, 3, 3, 0, 0
StretchBlt bm.hdc, 3, 0, w - 6, 3, bmx.hdc, 3, 0, 1, 3, vbSrcCopy
bmx.PaintPicture bm.hdc, w - 3, 0, 3, 3, 4, 0
StretchBlt bm.hdc, 0, 3, 3, h - 6, bmx.hdc, 0, 3, 3, 1, vbSrcCopy
StretchBlt bm.hdc, w - 3, 3, 3, h - 6, bmx.hdc, 4, 3, 3, 1, vbSrcCopy
bmx.PaintPicture bm.hdc, 0, h - 3, 3, 3, 4, 0
StretchBlt bm.hdc, 3, h - 3, w - 6, 3, bmx.hdc, 3, 4, 1, 3, vbSrcCopy
bmx.PaintPicture bm.hdc, w - 3, h - 3, 3, 3, 4, 4
'draw text TODO:two colors
DrawTextB bm.hdc, cap, Font, 0, 0, w, h, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE, vbBlack, , True
'paint
UserControl_Paint
End Sub
